perm filename CB.F4[DRW,LCS]1 blob sn#106234 filedate 1974-12-13 generic text, type T, neo UTF8
00100		SUBROUTINE CMBN
00200		COMMON /RC/MCLEF(400),IST(4000)
00300		COMMON /FL/NX,N,L,M,NM,J,NT
00400		DIMENSION IP(10),NMS(10),NF(2500),JP(10),NMX(10)
00500		EQUIVALENCE (IP,IST(3001)),(NMS,IST(3020)),(NF,IST(201))
00525		1,(JP,IST(1500)),(NMX,IST(1510))
00550	C *****   ******   ****   ******              ↑ 20 FOR OVERRUN IN IP(11) AT 119
00600	C  USE FILE NAMES CLFX, DRAW1 AND DRAW2.  400 WD LIMIT PER FILE.
00610		IF(N.EQ.'S')GO TO 103
00700	102	TYPE 1
00800	1	FORMAT(' TYPE OUTPUT FILE NAME ',$)
00900	10	FORMAT(A5)
00910		DO 122 K=1,10
00920		IP(K)=0
00955	122	NMS(K)=' '
01000		ACCEPT 10,NM
01050		IF(NM.NE.' ')GO TO 40
01055		NM=LASTNM
01057		TYPE 107,LASTNM
01060	40	LASTNM=NM
01100		IF(LOOKF(NM).EQ.0)GO TO 100
01110		IF(N.NE.'C')GO TO 103
01120	C  FOR ADDING TO COMBINED FILE.
01200		TYPE 101,NM
01300		ACCEPT 10,NX
01400		IF(NX.EQ.'N')GO TO 102
01410	100	IF(N.EQ.'C')GO TO 104
01420		TYPE 52
01430		GO TO 102
01800	104	L=0
01900		NX=1
02000		I=0
02050	30	L=L+1
02100		TYPE 41
02200	41	FORMAT(' TYPE FILE NAME ',$)
02300		ACCEPT 10,NW
02400		IF(NW.EQ.' ')GO TO 8
02500		IF(LOOKF(NW))GO TO 51
02600		TYPE 52
02700		GO TO 30
02800	52	FORMAT(' FILE NOT FOUND'/)
02900	51	I=I+1
02910		IP(L)=NX
03000		NMS(I)=NW
03100		CALL RDSAV(JP,NMX,K,NW,MCLEF(NX),-2)
03200		NX=NX+K
03300		IF(L.LT.10)GO TO 30
04900	101	FORMAT(' WRITE OVER ',A5,'.DMD?  Y OR N?  ',$)
05600	8	NX=NX-1
05700	14	CALL RDSAV(IP,NMS,NX,NM,MCLEF,0)
05750		L=NX
05800		RETURN
07210	
07220	1103	TYPE 1104,ID
07230	1104	FORMAT(' FILE FULL -- SAVED AS ',A5)
07240		L=1
07245		NM=ID
07250		NX=MCLEF(1)
07260		GO TO 8
07300	
07400	103	CALL RDSAV(IP,NMS,NX,NM,NF,-1)
08100	107	FORMAT(1X,A5)
08400		TYPE 109
08500	109	FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
08600		ACCEPT 10,ID
08610		IF(ID.EQ.' ')GO TO 102
08800		JD=0
08820		L=0
08840	CC	NX=NX-1
08900		DO 110 K=1,10
09000		IF(NMS(K).EQ.ID)JD=K
09100		IF(NMS(K).EQ.' ')GO TO 112
09105		L=K
09110	110	IF(JD.EQ.0.AND.K.EQ.10)GO TO 1103
09210	112	IF(N.EQ.'Z')GO TO 127
09230	C  FOR DELETIONS
09250		L=L+1
09300		IF(JD.NE.0)GO TO 111
09310	C ADDS ON TO END
09500		N=0
09550		IP(L)=NX+1
09600		DO 113 K=NX+1,MCLEF(1)+NX
09700		N=N+1
09800	113	NF(K)=MCLEF(N)
09900		NX=NX+N
10000		NMS(L)=ID
10010		L=L+1
10100	114	DO 115 K=1,NX
10200	115	MCLEF(K)=NF(K)
10300	C MOVES IT ALL TO MCLEF
10400		GO TO 14
10500	
10600	127	MCLEF(1)=0
10700	111	N=IP(JD)
10800		NR=MCLEF(1)
10900		M=NF(IP(JD))
11000		NW=NR-M
11010		NX=NX+NW
11020		IF(NW)201,120,203
11030	201	JA=N+NR
11040		JB=NX
11050		JC=1
11060		GO TO 204
11070	203	JA=NX
11080		JB=N+NW
11090		JC=-1
11100	204	DO 121 K=JA,JB,JC
11110	121	NF(K)=NF(K-NW)
11120		IF(NR.EQ.0)GO TO 126
11200	120	DO 117 K=1,NR
11300		NF(N)=MCLEF(K)
11400	117	N=N+1 
11410	CC	L=L-1
11420		IF(NW.EQ.0)GO TO 114
12000		DO 119 K=JD+1,L
12100	119	IP(K)=IP(K)+NW
12200	C  FIXES UP FIRST LINE.
12220	CC123	L=L-1
12260	CC	NX=NX-1
12300		GO TO 114
12400	126	IP(L+1)=0
12410	CC	L=L-1
12420		DO 124 K=JD,L-1
12440		IP(K)=IP(K+1)+NW
12460	124	NMS(K)=NMS(K+1)
12470		NMS(L)=' '
12480		GO TO 114
12900		END
13000	
13100		SUBROUTINE RDSAV(KT,NMS,K,NAME,IO,L)
13200	C  POINTER LIST, NAME LIST, WDCNT, FILE NAME, DATA, RD OR WRT.
13300		COMMON /RC/MCLEF(400),IST(4000)/FL/IC,NH,NQ,A,B,C,D
13400		DIMENSION KT(1),NMS(1),IO(1),JALL(21)
13420		IF(L)GO TO 5
13460	C  L=-1  FOR READER, -2=NO TYPE OF NAME LIST.
13500		DO 1 N=1,10
13600		JALL(N)=KT(N)
13700	1	JALL(N+11)=NMS(N)
13800		JALL(11)=K
14100		CALL PUTFIL(NAME)
14200		CALL FASTOU(JALL,21)
14300		CALL FASTOU(IO,K+1)
14400		CALL FINFIL
14500		RETURN
14600	
14700	5	CALL GETFIL(NAME)
14800		CALL FASTIN(JALL,21)
14900		K=JALL(11)
15000		CALL FASTIN(IO,K)
15100		DO 2 N=1,10
15200		KT(N)=JALL(N)
15300	2	NMS(N)=JALL(N+11)
15350		IF(L.EQ.-2)RETURN
15400		TYPE 3
15500		TYPE 4,(NMS(N),N=1,10)
15600	3	FORMAT(
15700		1'  0      1      2      3      4      5      6      7
15800		1      8      9')
15900	4	FORMAT(' IDENT. NAMES:'/,10(2XA5))
16000		END
16100	
16700		SUBROUTINE CNVT
16800		COMMON/RC/A(4400)
17000		DIMENSION J(10),NM(10),M(600),JALL(21)
17100		EQUIVALENCE(J,JALL,A),(NX,JALL(11)),(NM,JALL(12)),(M,A(2000))
17200	C  POINTER LIST, TOTAL WD CNT, NAME LIST.
17300		TYPE 1
17400	1	FORMAT(' TYPE OLD NAME --  '$)
17500		ACCEPT 2,N
17600	2	FORMAT(A5)
17700		TYPE 3
17800	3	FORMAT(' NEW NAME --  '$)
17900		ACCEPT 2,NN
18000		CALL IFILE(1,N)
18100		NX=1
18200		READ(1,4)K,J
18300	4	FORMAT(12I)
18400	6	READ(1,4,END=5)K,K,(M(L),L=NX,NX+K-1)
18500		REREAD 7,L,NM
18600		IF(NM(1))GO TO 5
18700		NX=NX+K
18800		GO TO 6
18900	7	FORMAT(I,10A5)
19000	
19300	5	NX=NX-1
19700		CALL RDSAV(J,NM,NX,NN,M,0)
19750	C  POINTERS, NAMES, WDCNT, FILE NAME, ARRAY, 0=WRITE
19800		CALL EXIT
19900		END